{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit InternetHelper;

interface

uses Classes, IdHTTP, IdAntiFreeze;

const
  HTTP_READ_TIMEOUT = 500; // no. of ms before timing out internet connection
  BROWSER_REG_KEY = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings';
  DEF_PROXY_HOST = '';
  DEF_PROXY_PORT = 80;
  DEF_PROXY_USER = '';
  DEF_PROXY_PASS = '';

type
  TAHMInternetHelper = class
  private
    FHTTP: TIdHTTP;
    FAntiFreeze: TIdAntiFreeze;
    FLocalIP: String;
    FConnected: Boolean;
    FProxyServer: String;
    FProxyPort: Integer;
    FProxyUser: String;
    FProxyPass: String;
  protected
    procedure SetDefaultProxy;
    procedure CheckConnection;
    function GetConnected: Boolean;
    function GetLocalIP: String;
    function GetPortAsString: String;
    procedure SetPortAsString(Port: String);
    procedure SetProxyServer(Server: String);
    procedure SetProxyPort(Port: Integer);
    procedure SetProxyUser(Username: String);
    procedure SetProxyPass(Password: String);
  public
    constructor Create;
    destructor Destroy; override;
    property IsConnected: Boolean read GetConnected;
    property LocalIPAddress: String read GetLocalIP;
    property ProxyServer: String read FProxyServer write SetProxyServer;
    property ProxyPort: Integer read FProxyPort write SetProxyPort;
    property ProxyPortAsString: String read GetPortAsString write SetPortAsString;
    property ProxyUsername: String read FProxyUser write SetProxyUser;
    property ProxyPassword: String read FProxyPass write SetProxyPass;
    function EncodeParams(Params: String): String;
    function Get(URL: String): String;
    function GetResource(URL: String; Stream: TStream): Boolean;
    function GetImageLinks(HTML: String; Links: TStrings): Boolean;
  end;

var
  InternetHelperInstance: TAHMInternetHelper;

implementation

uses SysUtils, StrUtils, Registry, Windows, IdIPWatch, IdURI;

constructor TAHMInternetHelper.Create;
begin
  inherited Create;

  // Create Indy HTTP component instance
  FHTTP := TIdHTTP.Create(nil);
  FHTTP.HandleRedirects := True;

  // Create Indy Antifreeze component instance (prevents GUI locking up)
  FAntiFreeze := TIdAntiFreeze.Create(nil);

  // Set default proxy values (may be overriden later)
  SetDefaultProxy;
end;

destructor TAHMInternetHelper.Destroy;
begin
  // Free Indy components
  FHTTP.Free;
  FAntiFreeze.Free;

  inherited Destroy;
end;

procedure TAHMInternetHelper.SetDefaultProxy;
const
  PROXY_ENABLED = 'ProxyEnable';
  PROXY_SERVER = 'ProxyServer';
var
  ProxyString: String;
  iPos: Integer;
begin
  // Set default values in case proxy not defined in registry
  ProxyServer := DEF_PROXY_HOST;
  ProxyPort := DEF_PROXY_PORT;
  ProxyUsername := DEF_PROXY_USER;
  ProxyPassword := DEF_PROXY_PASS;

  // Read default proxy settings from registry (these will be for system default browser)
  with TRegistry.Create do
  try
    RootKey := HKEY_CURRENT_USER;
    if OpenKeyReadOnly(BROWSER_REG_KEY) and ValueExists(PROXY_ENABLED) and
       ValueExists(PROXY_SERVER) and ReadBool(PROXY_ENABLED) then
    begin
      ProxyString := ReadString(PROXY_SERVER);
      iPos := Pos(':', ProxyString);
      if iPos > 0 then
      begin
        ProxyPort := StrToIntDef(Copy(ProxyString, iPos + 1, 10), DEF_PROXY_PORT);
        ProxyServer := Copy(ProxyString, 1, iPos - 1);
      end;
    end;
  finally
    Free;
  end;
end;

procedure TAHMInternetHelper.CheckConnection;
begin
  // Create Indy IP Watch instance to check connection
  with TIdIPWatch.Create(nil) do
  try
    // Don't persist IP history to file
    HistoryEnabled := False;

    // Force a check then record local IP and connectivity status
    ForceCheck;
    FLocalIP := CurrentIP;
    FConnected := IsOnline;
  finally
    Free;
  end;
end;

function TAHMInternetHelper.GetConnected: Boolean;
begin
  CheckConnection;
  Result := FConnected;
end;

function TAHMInternetHelper.GetLocalIP: String;
begin
  CheckConnection;
  Result := FLocalIP;
end;

function TAHMInternetHelper.GetPortAsString: String;
begin
  Result := IntToStr(FProxyPort);
end;

procedure TAHMInternetHelper.SetPortAsString(Port: String);
begin
  SetProxyPort(StrToIntDef(Port, FProxyPort));
end;

procedure TAHMInternetHelper.SetProxyServer(Server: String);
begin
  FProxyServer := Server;
  FHTTP.ProxyParams.ProxyServer := FProxyServer;
end;

procedure TAHMInternetHelper.SetProxyPort(Port: Integer);
begin
  FProxyPort := Port;
  FHTTP.ProxyParams.ProxyPort := FProxyPort;
end;

procedure TAHMInternetHelper.SetProxyUser(Username: String);
begin
  FProxyUser := Username;
  FHTTP.ProxyParams.ProxyUsername := FProxyUser;
end;

procedure TAHMInternetHelper.SetProxyPass(Password: String);
begin
  FProxyPass := Password;
  FHTTP.ProxyParams.ProxyPassword := FProxyPass;
end;

function TAHMInternetHelper.EncodeParams(Params: String): String;
begin
  Result := TIdURI.ParamsEncode(Params);
end;

function TAHMInternetHelper.Get(URL: String): String;
begin
  try
    // Override default HTTP request header to accept XML content
    FHTTP.Request.Accept := 'text/xml,text/html,text/plain,*/*';
    FHTTP.Request.ContentType := ''; // tag should not appear in request

    Result := FHTTP.Get(URL);
  except
    // Ignore timeout or connection errors
    Result := '';
  end;
end;

function TAHMInternetHelper.GetResource(URL: String; Stream: TStream): Boolean;
begin
  // Set default result - failed to retrieve
  Result := False;

  if Assigned(Stream) then
  try
    // Override default HTTP request header to accept XML content
    FHTTP.Request.Accept := 'text/xml,text/html,text/plain,*/*';
    FHTTP.Request.ContentType := ''; // tag should not appear in request

    FHTTP.Get(URL, Stream);
    if Stream.Size > 0 then Result := True;
  except
    // Ignore timeout or connection errors
  end;
end;

function TAHMInternetHelper.GetImageLinks(HTML: String; Links: TStrings): Boolean;
const
  TAG_IMAGE = '<IMG ';
  TAG_SOURCE = 'SRC=';
  TAG_END = '>';
var
  URL, UCResponse: String;
  iImg, iSrc, iEnd: Integer;
begin
  // Set default result - no images found
  Result := False;

  // We need a TStrings instance to pass results back
  if not Assigned(Links) then Exit;
  Links.Clear;

  // Build search URL & submit request
  if HTML <> '' then
  begin
    UCResponse := UpperCase(HTML); // ignore any case problems

    // Now the fun bit - parse HTML for any image tags
    iImg := Pos(TAG_IMAGE, UCResponse);
    while iImg > 0 do
    begin
      // Look for src attribute
      iSrc := PosEx(TAG_SOURCE, UCResponse, iImg + Length(TAG_IMAGE));
      if iSrc > 0 then
      begin
        // Look for closing tag
        iEnd := PosEx(TAG_END, UCResponse, iSrc + Length(TAG_SOURCE));
        if iEnd > 0 then
        begin
          // Append URL to our list of links
          URL := Copy(HTML, iSrc + Length(TAG_SOURCE), iEnd - iSrc - Length(TAG_SOURCE));
          Links.Add(URL);
          Result := True;

          iImg := iEnd + Length(TAG_END);
        end
        else
          iImg := iSrc + Length(TAG_SOURCE);
      end
      else
        iImg := iImg + Length(TAG_IMAGE);

      // Look for next image tag
      iImg := PosEx(TAG_IMAGE, UCResponse, iImg);
    end;
  end;
end;

initialization
  InternetHelperInstance := TAHMInternetHelper.Create;

finalization
  FreeAndNil(InternetHelperInstance);

end.
